perm filename TRANS1.LSP[206,JMC]1 blob
sn#005319 filedate 1971-01-05 generic text, type T, neo UTF8
00100 (DE TRANSFORM (E R DONE) (COND ((MEMBER E DONE) E)
00200 (T ((LAMBDA (W) (COND ((EQ W E) (COND ((ATOM E) E) (T ((LAMBDA (X Y) (COND
00300 ((AND (EQ X (CAR E)) (EQ Y (CDR E))) (SIDE E
00400 (SETQ DONE (CONS E DONE)))) (T (TRANSFORM (CONS X Y) R DONE))))
00500 (TRANSFORM (CAR E) R DONE) (TRANSFORM (CDR E) R DONE)))))
00600 (T (TRANSFORM W R DONE)))) (TRANSA E R)))))
00700
00800 (DE TRANSA (E R) (COND ((NULL R) E) (T
00900 ((LAMBDA (W) (COND ((EQ W E) (TRANSA E (CDR R))) (T W)))
01000 (TRANSB E (CAR R))))))
01100
01200 (DE TRANSB (E RULE) ((LAMBDA (W) (COND ((EQ W (QUOTE NO)) E)
01300 (T (SUBLIS (CADR RULE) W)))) (INST E (CAR RULE) NIL)))
01400
01500 (DE SIDE (X Y) X)
01600
01700 (SETQ R1 (QUOTE (
01800 ((PLUS X.Y) (PLUSA X (PLUS.Y)))
01900 ((PLUSA 0 . X) (PLUSA . X))
02000 ((PLUS.NIL) (PLUSB.NIL))
02100 ((PLUSA X (PLUSB.Y)) (PLUSB X.Y))
02200 ((PLUSA (PLUSB . X)) (PLUSB . X))
02300 )))
02400
02500 (SETQ R2 (QUOTE (
02600 ((PLUS X . Y) (PLUSA X (PLUS .Y)))
02700 ((PLUS . NIL) 0)
02800 ((PLUSA 0 . X) (PLUSA . X))
02900 ((PLUSA) 0)
03000 ((PLUSA X 0) X)
03100 ((PLUSA X) X)
03200 ((PLUSA (PLUSA X . Y) . Z) (PLUSA X (PLUSA . Y) .Z))
03300
03400 ((TIMES X . Y) (TIMESA X (TIMES . Y)))
03500 ((TIMES) 1)
03600 ((TIMESA 1 . X) (TIMESA . X))
03700 ((TIMESA) 1)
03800 ((TIMESA X 1) X)
03900 ((TIMESA X) X)
04000 ((TIMESA (TIMESA X . Y) . Z) (TIMESA X (TIMESA .Y) .Z))
04100
04200 ((TIMES 0 . X) 0)
04300 ((TIMESA 0 . X) 0)
04400 )))
04500
04600
04700 (SETQ R3 (QUOTE (
04800 ((PLUS X.Y) (X /+ .(PLUS.Y)))
04900 ((/+ PLUS.NIL) NIL)
05000 )))
05100
05200 (DE POOF (X Y) NIL)
05300
05400 (DE PRLIS (X) (COND ((NULL X) NIL)
05500 ((ATOM X) (POOF (PRINC X) NIL))
05600 (T (POOF (PRINC (CAR X)) (PRLIS (CDR X))))))
05700
05800 (SETQ R4 (QUOTE (
05900 ((PLUSA X Y) (PLUS X Y))
06000 ((PLUSA X (PLUS.Y)) (PLUS X . Y))
06100 )))